home *** CD-ROM | disk | FTP | other *** search
-
-
-
- program karakter_tanimlama;
- uses
- crt,graph,dos;
-
-
- var
- karakterler : array [0..1023] of byte;
- tablo_adresi_seg : word;
- tablo_adresi_ofs : word;
- a,ct : byte;
- kp : char;
- durum : byte;
- s : string;
- secilen_karakter : byte;
- deneme : byte;
- target : string[8];
-
-
- procedure byte_to_string(ascii:byte);
- begin
- target:='00000000';
- for a:=8 downto 1 do begin
- if ascii and trunc(exp((a-1)*ln(2)))<>0 then target[9-a]:='1' else
- target[9-a]:='0';
- end;
- end;
-
-
-
-
-
- procedure beep(a,b:integer);
-
- begin
- sound(a);delay(b);nosound;
- end;
-
-
- procedure grafik;
-
- var
- grDriver : Integer;
- grMode : Integer;
- ErrCode : Integer;
- begin
- grDriver := Detect;
- InitGraph(grDriver,grMode,'c:\tp\bgi');
- ErrCode := GraphResult;
- if ErrCode <> grOk then
- begin
- clrscr;
- writeln('grafik surucusu bulunamadi !');
- halt(1);
- end else
- end;
-
-
-
- procedure editor_penceresi_secilisi(st:byte);
- const
- x = 30;
- y = 300;
-
- begin
- if st=1 then begin
- setcolor(white);
- rectangle(x-1,y-1,x+161,y+161);
- end;
- if st=0 then begin
- setcolor(black);
- rectangle(x-1,y-1,x+161,y+161);
- end;
- end;
-
-
- procedure karakter_tablosu_secilisi(st:byte);
- const
- x = 425;
- y = 55;
-
- begin
- if st=1 then setcolor(white);
- rectangle(x-9,y-9,x+25*8+1,y+25*16+9);
- if st=0 then setcolor(black);
- rectangle(x-9,y-9,x+25*8+1,y+25*16+9);
- end;
-
- procedure karakter_tablosu(x,y:integer);
-
- var
- a,b,c:integer;
- begin
- c:=25;
- setcolor(white);
- setfillstyle(solidfill,blue);
-
- bar(x-8,y-8,x+c*8,y+c*16+8);
- settextstyle(defaultfont,horizdir,2);
-
-
- for a:=0 to 7 do begin
- for b:=0 to 15 do begin
- outtextxy(x+a*c,y+b*c,chr(128+a*16+b));
- end;
- end;
- setcolor(lightmagenta);
- rectangle(x-8,y-8,x+c*8,y+c*16+8);
- settextstyle(triplexfont,0,3);
- setcolor(lightgray);
- outtextxy(x+1,y-49,'Karakter Tablosu');
- setcolor(lightgreen);
- outtextxy(x,y-50,'Karakter Tablosu');
- end;
-
-
- procedure editor_penceresi(x,y:integer);
-
- var a,b,c:integer;
-
- begin
- c:=18;
- setfillstyle(solidfill,blue);
- for b:=0 to 7 do begin
- for a:=0 to 7 do begin
- bar(x+a*20,y+b*20,x+a*20+c,y+b*20+c);
- end;
- end;
- setcolor(magenta);
- rectangle(x-2,y-2,x+160,y+160);
- end;
-
- procedure karakter_tablosunu_tanimla;
-
- const Vector = $1F;
- var src, dst : pointer;
- begin
- src := ptr (MemW [0:Vector*4+2],MemW [0:Vector*4]);
- dst := ptr (seg(karakterler), ofs(karakterler));
- move (src^, dst^, sizeof(karakterler));
- MemW [0:Vector*4] := Ofs (karakterler);
- MemW [0:Vector*4+2] := Seg (karakterler);
- end;
-
- procedure tablo_reset;
- const Vector = $1F;
- begin
- MemW [0:Vector*4] := tablo_adresi_ofs;
- MemW [0:Vector*4+2] := tablo_adresi_seg;
- end;
-
-
- procedure editor_imleci(x,y:integer;st:byte);
-
- begin
-
- if st=1 then begin
- setfillstyle(solidfill,white);
- bar(x,y,x+18,y+18);
- end;
-
- if st=0 then begin
- setfillstyle(solidfill,blue);
- bar(x,y,x+18,y+18);
- end;
-
-
- end;
-
- procedure karakter_imleci(x,y:integer);
-
- begin
- setcolor(green);
- repeat
- setrgbpalette(green,random(64),random(64),random(64));
- rectangle(x-2,y-2,x+17,y+17);
- until (keypressed) or (kp=#9);
-
- setcolor(blue);
- rectangle(x-2,y-2,x+17,y+17);
- end;
-
- procedure karakteri_buyut(x,y:integer;karakter:byte);
-
- begin
-
- for ct:=0 to 7 do begin
- byte_to_string(karakterler[(karakter-128)*8+ct]);
- a:=1;
- repeat
- if target[a]='1' then editor_imleci(x+(a-1)*20,y,1);
- if target[a]='0' then editor_imleci(x+(a-1)*20,y,0);
- inc(a);
- until a=9;
- y:=y+20;
- end;
-
- end;
-
- procedure define;
- var a,b:byte;
- X,Y:INTEGER;
- begin
- settextstyle(defaultfont,0,1);
- for b:=0 to 7 do begin
- target:='00000000';
- for a:=0 to 7 do begin
- if getpixel(40+a*20,310+b*20)=white then target[a+1]:='1';
- if getpixel(40+a*20,310+b*20)=blue then target[a+1]:='0';
- end;
- deneme:=0;
- for ct:=0 to 7 do begin
- if target[8-ct]='1' then deneme:=deneme+trunc(exp(ct*ln(2))) else begin end;
- end;
- karakterler[(secilen_karakter-128)*8+b]:=deneme;
- karakter_tablosunu_tanimla;
-
- setfillstyle(solidfill,black);
- bar(280,340,310,365);
- settextstyle(defaultfont,horizdir,3);
- setcolor(yellow);
- outtextxy(280,340,chr(secilen_karakter));
-
-
- end;
- end;
-
- procedure karakter_tablosunu_kaydet;
-
- var f : file;
- w: word;
- begin
- assign(f,'C:\karakter.tan');
- rewrite (f,1);
- blockwrite (f,karakterler,sizeof(karakterler),w);
- close(f);
- end;
-
- procedure karakter_tablosunu_yukle;
-
- var f : file;
- w: word;
- begin
- assign(f,'C:\karakter.tan');
- reset(f,1);
- blockread(f,karakterler,sizeof(karakterler),w);
- close(f);
- karakter_tablosunu_tanimla;
- karakter_tablosu(425,55);
- end;
-
-
-
- procedure editor(karakter:byte);
-
- var x,y:integer;
-
- begin
- x:=30;y:=300;
- editor_penceresi_secilisi(1);
- karakteri_buyut(x,y,karakter);
- define;
-
-
- x:=30;y:=300;
- editor_imleci(x,y,1);
- kp:=#0;
-
- repeat;
- define;
- kp:=readkey;
- setfillstyle(solidfill,black);
- if (kp='Y') or (kp='y') then durum:=1;
- if (kp='S') or (kp='s') then durum:=0;
- if (kp='K') or (kp='k') then karakter_tablosunu_kaydet;
- if (kp='L') or (kp='l') then karakter_tablosunu_yukle;
-
- editor_imleci(x,y,durum);
- if kp=#0 then case readkey of
-
- 'K' : x:=x-20;
- 'M' : x:=x+20;
- 'H' : y:=y-20;
- 'P' : y:=y+20;
-
-
-
-
- end;
-
- if x<30 then x:=30;
- if y<300 then y:=300;
- if x>170 then x:=170;
- if y>440 then y:=440;
-
- editor_imleci(x,y,1);
-
-
- until kp=#9;
-
- editor_penceresi_secilisi(0);
- end;
-
-
- procedure karakter_secme;
-
- var x,y:integer;
- begin
- x:=450;y:=55;
- karakter_tablosu_secilisi(1);
- settextstyle(defaultfont,horizdir,3);
- setcolor(yellow);
- outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
- str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
- secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
- settextstyle(triplexfont,horizdir,4);
- outtextxy(260,415,s);
- karakteri_buyut(30,300,secilen_karakter);
-
- repeat;
- karakter_imleci(x,y);
- kp:=readkey;
- if (kp='K') or (kp='k') then karakter_tablosunu_kaydet;
- setfillstyle(solidfill,black);
- bar(280,340,310,365);
- bar(260,425,320,450);
- if kp=#0 then case readkey of
-
- 'K' : x:=x-25;
- 'M' : x:=x+25;
- 'H' : y:=y-25;
- 'P' : y:=y+25;
-
-
-
- end else if (kp='c') or (kp='C') or (kp=#27) then begin
- closegraph;
- writeln('karakter tanimlama programindan
- ciktiniz');
- tablo_reset;
- halt(0);
-
- end;
-
- if x<425 then x:=425;
- if y<55 then y:=55;
- if x>600 then x:=600;
- if y>430 then y:=430;
-
- settextstyle(defaultfont,horizdir,3);
- setcolor(yellow);
- outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
- str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
- secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
- karakteri_buyut(30,300,secilen_karakter);
-
- settextstyle(triplexfont,horizdir,4);
- outtextxy(260,415,s);
- karakter_imleci(x,y);
- setfillstyle(solidfill,black);
- bar(280,340,310,365);
- bar(260,425,320,450);
-
-
- if kp=#9 then begin end;
- until kp=#9;
-
- settextstyle(defaultfont,horizdir,3);
- setcolor(yellow);
- outtextxy(280,340,chr(trunc(128+(x-425)/25*16+(y-55)/25)));
- str((trunc(128+(x-425)/25*16+(y-55)/25)),s);
- secilen_karakter:=(trunc(128+(x-425)/25*16+(y-55)/25));
- settextstyle(triplexfont,horizdir,4);
- outtextxy(260,415,s);
- karakter_tablosu_secilisi(0);
-
- end;
-
- procedure reklam(x,y:integer);
-
- begin
- setcolor(white);
- settextstyle(triplexfont,horizdir,2);
- outtextxy(x+1,y+1,'KARAKTER TANIMLAMA PROGRAMI');
- setcolor(magenta);
- settextstyle(triplexfont,horizdir,2);
- outtextxy(x,y,'KARAKTER TANIMLAMA PROGRAMI');
-
- setcolor(lightred);
- settextstyle(triplexfont,horizdir,1);
- outtextxy(x,y+50,'Bu program Cenk TARHAN tarafindan');
- outtextxy(x,y+70,'PCWorld/Turkiye Programlama Sanati');
- outtextxy(x,y+90,'Eki icin yazilmistir...');
-
- setcolor(red);
- settextstyle(triplexfont,horizdir,1);
- x:=x-1;y:=y-1;
- outtextxy(x,y+50,'Bu program Cenk TARHAN tarafindan');
- outtextxy(x,y+70,'PCWorld/Turkiye Programlama Sanati');
- outtextxy(x,y+90,'Eki icin yazilmistir...');
-
-
- end;
-
- procedure kullanim(x,y:integer);
-
- begin
- setcolor(lightgreen);
- settextstyle(triplexfont,horizdir,2);
- outtextxy(x,y,'[ Y ] ... Yazma modu');
- outtextxy(x,y+20,'[ S ] ... Silme modu');
- outtextxy(x,y+40,'[ L ] ... Diskten dosya yukleme');
- outtextxy(x,y+60,'[ K ] ... Diske dosya kaydetme');
- outtextxy(x,y+80,'[ C ] ... Programdan cikis');
- end;
-
- procedure ornekleme_bolgesi(x,y:integer);
-
- begin
- setcolor(magenta);
- rectangle(220,298,370,460);
- line(220,330,370,330);
- rectangle(220,380,370,415);
- settextstyle(triplexfont,horizdir,1);
- setcolor(lightblue);
- outtextxy(x+1,y+1,' Karakter :');
- setcolor(blue);
- outtextxy(x,y,' Karakter :');
-
-
- setcolor(lightblue);
- outtextxy(x+1,y+86,'ASCII Kodu :');
- setcolor(blue);
- outtextxy(x,y+85,'ASCII Kodu :');
-
- end;
-
-
-
- { ana programin baslangici }
-
- begin
- tablo_adresi_ofs := MemW [0:$1f*4];
- tablo_adresi_seg := MemW [0:$1f*4+2];
-
- grafik;
- setcolor(darkgray);
- rectangle(0,0,639,479);
- karakter_tablosunu_tanimla;
- karakter_tablosu(425,55);
- editor_penceresi(30,300);
- editor_imleci(30,300,2);
- ornekleme_bolgesi(230,300);
- kullanim(30,180);
- reklam(10,5);
- repeat
- karakter_secme;
- kp:=#0;
- editor(secilen_karakter);
- karakter_tablosu(425,55);
- until (kp='c') or (kp='C');
- closegraph;
- writeln('karakter tanimlama programindan ciktiniz');
- tablo_reset;
- end.